home *** CD-ROM | disk | FTP | other *** search
/ Acorn User: China / Acorn User China CD-ROM (UK) (Disc A) / Acorn User China CD-ROM (UK) (Disc A).bin / HENSA / MATHS / JACAL.ARC / jacal_math < prev    next >
Encoding:
Text File  |  1994-01-21  |  1.9 KB  |  61 lines
  1. ;;; JACAL: Symbolic Mathematics System.        -*-scheme-*-
  2. ;;; Copyright 1989, 1990, 1991, 1992, 1993 Aubrey Jaffer.
  3. ;;; See the file "COPYING" for terms applying to this program.
  4.  
  5. ;;; See Template.scm in the Scheme Library for how to set up
  6. ;;; vicinities and require.
  7.  
  8. ;;; (define jacal-vicinity (program-vicinity))
  9. (define jacal-vicinity "<JACAL>.")
  10.  
  11. ;;    Save our vicinity for later dynamic loads.
  12. ;;; (load (in-vicinity (program-vicinity) "scl" (scheme-file-suffix)))
  13. (load "<JACAL>.scl")
  14.  
  15. ;;    Common Lisp/Scheme compatability definitions.
  16. ;; (load (in-vicinity (program-vicinity) "toploads" (scheme-file-suffix)))
  17. (load "<JACAL>.toploads")
  18.  
  19. ;;    Initialize modes to something reasonable.
  20. ;; (load (in-vicinity (program-vicinity) "modeinit" (scheme-file-suffix)))
  21. (load "<JACAL>.modeinit")
  22.  
  23. ;;; this should move into SLIB
  24. ;(define (output-port-height . arg) 23)
  25.  
  26. ;;;; error and interrupt response for SCM.
  27. ;;; Put appropriate handlers for other systems here.
  28.  
  29. (define (impl:error str)
  30.   (force-output)
  31.   (newline-diag)
  32.   (perror (tran:translate 'ERROR))
  33.   (set-errno 0)
  34.   (display-diag str)
  35.   (display-diag (tran:translate 'Last-expression-lost))
  36.   (newline-diag)
  37.   (force-output)
  38.   (math:exit #f))            ;return to math top level.
  39.  
  40. ;;;; These are error handlers for SCM.
  41. (define out-of-storage #f)
  42. (define could-not-open #f)
  43. (define arithmetic-error #f)
  44. (define user-interrupt #f)
  45. (define end-of-program #f)
  46. ;(define hang-up end-of-program)        ;automatic
  47.  
  48. (define (set-handlers!)
  49. ;;  (set! out-of-storage (lambda () (impl:error "Out of storage")))
  50.   (set! could-not-open (lambda () (impl:error "File not found")))
  51.   (set! arithmetic-error (lambda () (impl:error "Arithmetic Error")))
  52. ;;  (set! user-interrupt (lambda () (impl:error "User Interrupt")))
  53.   (set! end-of-program (lambda () (math:exit #t))))
  54.  
  55. (define (cleanup-handlers!)
  56.   (set! out-of-storage #f)
  57.   (set! could-not-open #f)
  58.   (set! arithmetic-error #f)
  59.   (set! user-interrupt #f)
  60.   (set! end-of-program #f))
  61.